Transformative Change Assessment - Ch 3 - Clusters

Back to Readme

Waiting for new key-papers

Setup

#|
if (!exists("params")) {
    params <- rmarkdown::yaml_front_matter("snowball.qmd")$params
}

knitr::opts_chunk$set(message = NA)

library(IPBES.R)
library(openalexR)

Thank you for using openalexR!
To acknowledge our work, please cite the package by calling `citation("openalexR")`.
To suppress this message, add `openalexR.message = suppressed` to your .Renviron file.

library(dplyr)

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

library(readxl)

library(tibble)
# library(dplyr)
# library(knitr)
library(networkD3)
library(tictoc)

library(patchwork)

# devtools::install_github("mattflor/chorddiag")
library(chorddiag)

dir.create(params$gdm_path, showWarnings = FALSE)

fns <- sapply(
    1:6,
    function(i) {
        gsub(
            pattern = "X",
            replacement = i,
            x = file.path("input", "key_papers", params$key_paper)
        )
    }
)

###########
## Update `cX_key-paper.csv` from `TCA_Ch3_DOIs_Dataset_Theories_3_May_2024.xlsx`
## This needs to be run manually

if (FALSE) {
    all <- readxl::read_excel(file.path("input", "key_papers", "TCA_Ch3_DOIs_Dataset_Theories_3_May_2024.xlsx"))

    cluster <- names(all)[11:16]

    sapply(
        1:6,
        function(i) {
            all |>
                dplyr::filter(.data[[cluster[[i]]]] == 1) |>
                dplyr::select("DOI", "Authors", "Year", "Title") |>
                dplyr::filter(!is.na(DOI)) |>
                dplyr::mutate(
                    DOI = gsub(
                        pattern = "https://doi.org/",
                        replacement = "",
                        x = DOI
                    )
                ) |>
                write.csv(
                    file = fns[i],
                    row.names = FALSE
                )
        }
    ) |>
        invisible()

    rm(all, cluster)
}

##
###########
cluster <- lapply(
    fns,
    function(fn) {
        list(
            fn = fn,
            dois = read.csv(fn)$DOI
        )
    }
)

names(cluster) <- paste0("cluster_", 1:6)

Verification of key papers

The key papers should describe the cluster, exactly one cluster, and not multiple clusters. In other words, a key paper should only be in one cluster. If a key-papers is in multiple clusters, this would lead to an overlap wof the snowball corpus which is not caused by the cluster itself, but by the key paper which is in multiple clusters.

The papers are the following (the table will be empty if there are none):

dupl_kp <- lapply(
    cluster,
    function(cl) {
        x <- cl$dois
        x[x != ""]
    }
) |>
    unlist()
dupl_kp <- dupl_kp[duplicated(dupl_kp)]

sprintf('<a href="https://doi.org/%s" target="_blank">%s</a>', dupl_kp, dupl_kp) |>
    knitr::kable()

x
10.1016/S0160-791X(03)00025-3
10.1080/2157930X.2013.876800
10.3152/030234207X193619
10.1386/ijtm.8.3.177/1
10.1080/2157930X.2017.1351605
10.1016/j.respol.2017.09.007
10.4324/9780203729724
10.1177/0309132511425767
10.1146/annurev-environ-102014-021340
10.5751/ES-05072-180327
10.1080/09505431.2015.1081500
10.4324/9781315622880
10.17351/ests2015.21
10.1146/annurev-anthro-092412-155522
10.1177/00027649921955326
10.4324/9781003276203
10.1186/s40594-021-00296-x
10.1016/j.envsci.2012.11.011
10.4324/9780203817438
10.1093/biosci/biad109
10.1016/j.ecolecon.2013.06.008
10.1007/s11625-019-00718-4
10.3389/fevo.2021.624084
10.1080/26395916.2020.1814417
10.1073/pnas.1525002113
10.1016/j.cosust.2018.11.003
10.1080/00141840600603111
10.3197/096327111X13077055166063
10.4337/9781843765486
10.1016/j.gloenvcha.2021.102422
10.5751/es-10607-230432
http://dx.doi.org/10.5751/ES-10177-230302
10.1007/s11625-019-00749-x
10.1016/j.futures.2021.102836
10.1007/s13280-023-01873-w
10.1080/13504500709469709
10.1111/j.1530-9290.2009.00116.x
10.4324/9780203856598
10.1016/j.respol.2018.08.011
10.4324/9781315747378-4
10.1016/j.respol.2011.10.015
10.1093/oso/9780199256044.001.0001
10.1016/j.cosust.2021.06.002

These papers will be excluded from the analysis.

for (i in grep("cluster", names(cluster), value = TRUE)) {
    cluster[[i]]$dois <- cluster[[i]]$dois[!cluster[[i]]$dois %in% dupl_kp]
}

Do Searches

Get Generell key-works and Snowball

#|

fn <- file.path("data", "key_works.rds")
if (exists(fn)) {
    key_works <- readRDS(fn)
} else {
    dois <- read.csv(file.path("input", "key_papers", "key-paper.csv"))$DOI
    key_works <- oa_fetch(
        entity = "works",
        doi = dois,
        verbose = FALSE
    )
    saveRDS(key_works, fn)
}

ids <- openalexR:::shorten_oaid(key_works$id)

fn <- file.path("data", "snowball.rds")
if (file.exists(fn)) {
    snowball <- readRDS(fn)
} else {
    snowball <- oa_snowball(
        identifier = ids,
        verbose = FALSE
    )
    saveRDS(snowball, fn)
}

flat_snow <- snowball2df(snowball) |>
    tibble::as_tibble()

Get Cluster key-works and Snowballs

#|
tic()
fn <- file.path("data", "cluster.rds")
if (file.exists(fn)) {
    cluster <- readRDS(fn)
} else {
    cluster <- lapply(
        cluster,
        function(cl) {
            message("Processing ", cl$fn, " ...")
            message("|- Fetching works...")
            key_works <- oa_fetch(
                entity = "works",
                doi = cl$dois,
                verbose = FALSE
            )
            key_works$id <- gsub(
                pattern = "https://openalex.org/",
                replacement = "",
                key_works$id
            )
            message("|- Snowballing works...")
            snowball <- oa_snowball(
                identifier = openalexR:::shorten_oaid(key_works$id),
                verbose = FALSE
            )
            message("|- Converting to tibble...")
            snowball_df <- snowball2df(snowball) |>
                as_tibble()
            message("\n")
            list(
                cl,
                key_works = key_works,
                snowball_1 = snowball,
                snowball_1_df = snowball_df
            )
        }
    )

    ## Detemine linkages between Clusters

    nodes <- data.frame(
        id = names(cluster),
        n = sapply(
            cluster,
            function(cl) {
                nrow(cl$snowball_1$nodes)
            }
        ),
        n_kp = sapply(
            cluster,
            function(cl) {
                nrow(cl$key_works)
            }
        ),
        stringsAsFactors = FALSE
    )

    edges <- expand.grid(
        names(cluster),
        names(cluster),
        stringsAsFactors = FALSE
    )
    names(edges) <- c("from", "to")
    edges <- edges[edges$from != edges$to, ]
    rownames(edges) <- NULL

    ## in_l1: keypaper c1 %in% keypaper c2
    edges$in_l1 <- sapply(
        1:nrow(edges),
        function(i) {
            cluster[[edges$from[i]]]$key_works$id %in% cluster[[edges$to[i]]]$key_works$id |>
                sum()
        }
    )

    ## in_l2: keypaper c1 %in% nodes c2
    edges$in_l2 <- sapply(
        1:nrow(edges),
        function(i) {
            cluster[[edges$from[i]]]$key_works$id %in% cluster[[edges$to[i]]]$snowball_1$nodes$id |>
                sum()
        }
    )

    ## in_l3: nodes c1 %in% nodes c2
    edges$in_l3 <- sapply(
        1:nrow(edges),
        function(i) {
            cluster[[edges$from[i]]]$snowball_1$nodes$id %in% cluster[[edges$to[i]]]$snowball_1$nodes$id |>
                sum()
        }
    )

    cluster$links <- list(
        nodes = nodes,
        edges = edges
    )

    saveRDS(cluster, fn)
}


key_works_cluster <- lapply(
    1:(length(cluster) - 1),
    function(i) {
        cluster[[i]]$key_works
    }
) |>
    do.call(what = rbind) |>
    dplyr::distinct(id, .keep_all = TRUE)

snowball_cluster <- list(
    nodes = lapply(
        1:(length(cluster) - 1),
        function(i) {
            cluster[[i]]$snowball_1$nodes
        }
    ) |>
        do.call(what = rbind) |>
        dplyr::distinct(id, .keep_all = TRUE),
    edges = lapply(
        1:(length(cluster) - 1),
        function(i) {
            cluster[[i]]$snowball_1$edges
        }
    ) |>
        do.call(what = rbind) |>
        dplyr::distinct()
)

toc()

53.755 sec elapsed

Do second snowball search (S2)

For the second snowball search (S2) we use the corpus identified by S1 as the key-papers.

This needs to be enabled (eval = false needs to be changed to eval = true in the following code block) as the resulting data file is to large for github and running of the snowball search takes several hours.

cluster <- lapply(
    cluster,
    function(cl) {
        message("Processing ", cl$fn, " ...")
        message("|- Snowballing works 2nd gen...")
        snowball <- oa_snowball(
            identifier = cl$snowball_1$nodes$id,
            verbose = FALSE
        )
        message("|- Converting to tibble...")
        snowball_df <- snowball2df(snowball) |>
            as_tibble()
        message("\n")
        list(
            cl,
            snowball_2 = snowball,
            snowball_2_df = snowball_df
        )
    }
)
saveRDS(cluster, fn)

Create Graphs

Create Static Citation Network Graph of the S1 Corpus

Only S1 corpus of S1 can be graphed due to the size of the S2 corpus.

#|

tic()

lapply(
    names(cluster),
    function(name) {
        plot_name <- paste0(name, "_S1")
        if (length(list.files("figures", pattern = paste0(plot_name, ".*(pdf|png)"))) < 4) {
            message("Plotting ", name, " ...")
            try(
                plot_snowball(
                    cluster[[name]]$snowball_1,
                    name = plot_name
                ) |>
                    invisible(),
                silent = FALSE
            )
        }
    }
)

toc()

Create Interactive Citation Network Graph of the S1 Corpus

#|

tic()

lapply(
    names(cluster),
    function(name) {
        plot_name <- paste0(name, paste0(name, "_S1_interactive_network.html"))
        if (!file.exists(file.path("figures", plot_name))) {
            message("Plotting Interactive", name, " ...")
            nwg <- IPBES.R::plot_snowball_interactive(
                snowball = cluster[[name]]$snowball_1,
                key_works = cluster[[name]]$key_works,
                file = file.path("figures", plot_name)
            )
        }
    }
)

toc()

Create Maps of the S1 Corpus

Create Maps of the first author only

#|

tic()

maps <- lapply(
    grep("cluster_", names(cluster), value = TRUE),
    function(name) {
        plot_name <- paste0("map_first_author_", name, "__S1")
        message("Plotting map ", name, " ...")
        map <- sapply(
            cluster[[name]]$snowball_1$nodes$author,
            function(authors) {
                if (is.null(names(authors))) {
                    return(NULL)
                } else {
                    authors[["institution_country_code"]][[1]]
                }
            }
        ) |>
            unlist() |>
            table(useNA = "no") |>
            as.data.frame() |>
            dplyr::rename(
                iso2c = Var1,
                n = Freq
            ) |>
            dplyr::mutate(
                log_n_1 = log(n) + 1
            ) |>
            IPBES.R::map_country_codes(
                values = "log_n_1",
                geodata_path = params$gdm_path
            ) +
            ggplot2::ggtitle(paste(name, "First Author Only"))

        if (length(list.files("maps", pattern = paste0(plot_name, ".*(pdf|png)"))) < 2) {
            ggplot2::ggsave(
                file.path("maps", paste0(plot_name, ".pdf")),
                map,
                width = 5,
                height = 2.5
            )
            ggplot2::ggsave(
                file.path("maps", paste0(plot_name, ".png")),
                map,
                width = 5,
                height = 2.5
            )
        }
        return(map)
    }
)

Warning in IPBES.R::map_country_codes(dplyr::mutate(dplyr::rename(as.data.frame(table(unlist(sapply(cluster[[name]]$snowball_1$nodes$author, : The following countries are not in the world dataset: 
MCO, MDV
and will therefore not be plotted!

Warning: Some values were not matched unambiguously: XK

Warning in IPBES.R::map_country_codes(dplyr::mutate(dplyr::rename(as.data.frame(table(unlist(sapply(cluster[[name]]$snowball_1$nodes$author, : The following countries are not in the world dataset: 
MCO, NA
and will therefore not be plotted!

Warning: Some values were not matched unambiguously: XK

Warning in IPBES.R::map_country_codes(dplyr::mutate(dplyr::rename(as.data.frame(table(unlist(sapply(cluster[[name]]$snowball_1$nodes$author, : The following countries are not in the world dataset: 
NA
and will therefore not be plotted!

Warning: Some values were not matched unambiguously: XK

Warning in IPBES.R::map_country_codes(dplyr::mutate(dplyr::rename(as.data.frame(table(unlist(sapply(cluster[[name]]$snowball_1$nodes$author, : The following countries are not in the world dataset: 
MCO, NA
and will therefore not be plotted!

plot_name <- "map_first_author__S1"
if (length(list.files("maps", pattern = paste0("^", plot_name, ".*(pdf|png)"))) < 2) {
    map <- patchwork::wrap_plots(
        plots = maps,
        ncol = 3
    )
    ggplot2::ggsave(
        file.path("maps", paste0(plot_name, ".pdf")),
        map,
        width = 15,
        height = 5
    )
    ggplot2::ggsave(
        file.path("maps", paste0(plot_name, ".png")),
        map,
        width = 15,
        height = 5
    )
}
rm(map, maps)

toc()

11.013 sec elapsed

Create Maps of the all authors. All authors are weighted equal for now.

#|

tic()

maps <- lapply(
    grep("cluster_", names(cluster), value = TRUE),
    function(name) {
        plot_name <- paste0("map_all_authors_", name, "__S1")
        message("Plotting map ", name, " ...")
        map <- sapply(
            cluster[[name]]$snowball_1$nodes$author,
            function(authors) {
                if (is.null(names(authors))) {
                    return(NULL)
                } else {
                    authors[["institution_country_code"]]
                }
            }
        ) |>
            unlist() |>
            table(useNA = "no") |>
            as.data.frame() |>
            dplyr::rename(
                iso2c = Var1,
                n = Freq
            ) |>
            dplyr::mutate(
                log_n_1 = log(n) + 1
            ) |>
            IPBES.R::map_country_codes(
                values = "log_n_1",
                geodata_path = params$gdm_path
            ) +
            ggplot2::ggtitle(paste(name, "All Authors"))

        if (length(list.files("figures", pattern = paste0(plot_name, ".*(pdf|png)"))) < 2) {
            ggplot2::ggsave(
                file.path("figures", paste0(plot_name, ".pdf")),
                map,
                width = 5,
                height = 2.5
            )
            ggplot2::ggsave(
                file.path("figures", paste0(plot_name, ".png")),
                map,
                width = 5,
                height = 2.5
            )
        }
        return(map)
    }
)

Warning in IPBES.R::map_country_codes(dplyr::mutate(dplyr::rename(as.data.frame(table(unlist(sapply(cluster[[name]]$snowball_1$nodes$author, : The following countries are not in the world dataset: 
MCO, MDV
and will therefore not be plotted!

Warning: Some values were not matched unambiguously: XK

Warning in IPBES.R::map_country_codes(dplyr::mutate(dplyr::rename(as.data.frame(table(unlist(sapply(cluster[[name]]$snowball_1$nodes$author, : The following countries are not in the world dataset: 
BMU, GIB, MCO, MDV, SMR, TUV, NA
and will therefore not be plotted!

Warning: Some values were not matched unambiguously: XK

Warning in IPBES.R::map_country_codes(dplyr::mutate(dplyr::rename(as.data.frame(table(unlist(sapply(cluster[[name]]$snowball_1$nodes$author, : The following countries are not in the world dataset: 
NA
and will therefore not be plotted!

Warning: Some values were not matched unambiguously: XK

Warning in IPBES.R::map_country_codes(dplyr::mutate(dplyr::rename(as.data.frame(table(unlist(sapply(cluster[[name]]$snowball_1$nodes$author, : The following countries are not in the world dataset: 
MCO, NA
and will therefore not be plotted!

plot_name <- "map_all_authors__S1"
if (length(list.files("maps", pattern = paste0("^", plot_name, ".*(pdf|png)"))) < 2) {
    map <- patchwork::wrap_plots(
        plots = maps,
        ncol = 3
    )
    ggplot2::ggsave(
        file.path("maps", paste0(plot_name, ".pdf")),
        map,
        width = 15,
        height = 5
    )
    ggplot2::ggsave(
        file.path("maps", paste0(plot_name, ".png")),
        map,
        width = 15,
        height = 5
    )
}
rm(map, maps)
toc()

7.092 sec elapsed

Results

Graphs and Maps

The following interactions are possible in the interactive graphs:

• moving your mouse over a node, the title author and year of the paper is shown.
• clicking on a node will open the paper in a new tab.
• scrolling up and down with your scroll wheel zooms in and out
• clicking on the canvas and move the mouse will move the network
• clicking on a node and dragging it moves the node

Overview Maps

First Author Only

All Authors no weighting

Cluster 1

Ach so.

• Better quality map
• Better quality cluster
• Interactive.

Cluster 2

• Better quality map
• Better quality cluster
• Interactive.

Cluster 3

• Better quality map
• Better quality cluster
• Interactive.

Cluster 4

• Better quality map
• Better quality cluster
• Interactive.

Cluster 5

!

• Better quality map
• Better quality cluster
• Interactive.

Cluster 6

• Better quality map
• Better quality cluster
• Interactive.

Common works between clusters

This section looks at common works between the keypapers of each cluster as well as the whole corpus as obtained through a first generation snowball search using the provided keyworks.

The links are classifiad using three levels:

• in_l1: (keypaper in from) in (keypaper in to)
• in_l2: (keypaper in from) in (snowball in to)
• in_l3: (snowball in from) in (snowball in to)

Cluster properties

• n: number of papers in the snowball corpus
• n_kp: number of keypapers

IPBES.R::table_dt(data = cluster$links$nodes[, -1])

Links between clusters

• from: cluster which is the cluster in which the papers are
• to: cluster to which the from cluster is compared to
• in_l1: (keypaper in from) in (keypaper in to)
• in_l2: (keypaper in from) in (snowball in to)
• in_l3: (snowball in from) in (snowball in to)

IPBES.R::table_dt(data = cluster$links$edges)

The column in_l1 shgould be all zeros as the keypapers should only be linked to one cluster and not to multiple clusters.

Links between Clusters

#|

n_clust <- data.frame(
    from = cluster$links$nodes$id,
    to = cluster$links$nodes$id,
    in_l1 = cluster$links$nodes$n_kp,
    in_l2 = cluster$links$nodes$n_kp,
    in_l3 = cluster$links$nodes$n
) |>
    select(from, in_l1, in_l2, in_l3) |>
    dplyr::rename(n_l1 = in_l1, n_l2 = in_l2, n_l3 = in_l3)

linkages <- n_clust |>
    merge(x = cluster$links$edges, by = "from") |>
    group_by(from) |>
    summarize(
        in_l1 = unique(n_l1) - sum(in_l1),
        in_l2 = unique(n_l2) - sum(in_l2),
        in_l3 = unique(n_l3) - sum(in_l3)
    ) |>
    ungroup() |>
    mutate(to = from) |>
    relocate(to, .after = "from") |>
    rbind(cluster$links$edges)

linkages_p <- merge(
    linkages,
    n_clust,
    by = "from"
) |>
    mutate(
        in_l1 = in_l1 / n_l1,
        in_l2 = in_l2 / n_l2,
        in_l3 = in_l3 / n_l3,
        n_l1 = NULL,
        n_l2 = NULL,
        n_l3 = NULL
    ) |>
    as_tibble()


####

plot_chord <- function(linkages, level) {
    m <- linkages |>
        select(from, to, contains(level)) |>
        tidyr::pivot_wider(
            names_from = to,
            values_from = contains(level)
        )
    rown <- m$from
    m <- m[, -1]
    m <- m[, sort(names(m))]
    m <- as.matrix(m)
    m[] <- as.numeric(m[])
    dimnames(m)[[1]] <- rown

    cd <- chorddiag(
        m,
        groupnamePadding = 20,
        type = "directional"
    )
    return(cd)
}

Level 1

Number of keypapers in one cluster in the keypapers of another cluster.

#|

plot_chord(linkages, "l1")

plot_chord(linkages_p, "l1")

Level 2

Number of keypapers in one cluster in the snowball corpus of another cluster.

#|

plot_chord(linkages, "l2")

plot_chord(linkages_p, "l2")

Level 3

Number of papers in the snowball corpus in one cluster in the snowball corpus of another cluster.

#|

plot_chord(linkages, "l3")

plot_chord(linkages_p, "l3")

Common works between Cluster and General corpus

Overlab between Cluster and General key-papers and corpi

Here I will show the overlap between the combined cluster corpi and the General corpus based on the six key paper.

	Cluster	General	overlap
(keypaper <-> keypaper)	154	6	1
(keypaper <-> paper)	154	2130	30
(paper <-> keypaper)	143086	6	6
(paper <-> paper)	143086	2130	1485

(keypaper <-> keypaper)

key_works_cluster[key_works_cluster$id %in% gsub("^https://openalex.org/", "", key_works$id), ] |>
    IPBES.R::table_dt(fixedColumns = NULL)

(keypaper <-> paper)

key_works_cluster[key_works_cluster$id %in% snowball$nodes$id, ] |>
    IPBES.R::table_dt(fixedColumns = NULL)

(paper <-> keypaper)

snowball_cluster$nodes[snowball_cluster$nodes$id %in% gsub("^https://openalex.org/", "", key_works$id), ] |>
    IPBES.R::table_dt(fixedColumns = NULL)

(paper <-> paper)

snowball_cluster$nodes[snowball_cluster$nodes$id %in% snowball$nodes$id, ] |>
    IPBES.R::table_dt(fixedColumns = NULL)

Warning in instance$preRenderHook(instance): It seems your data is too big for
client-side DataTables. You may consider server-side processing:
https://rstudio.github.io/DT/server.html